PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/shazam.exe/INPUT2.INC

Text File | 1992-09-01 | 5.7 KB | 189 lines

   {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

   DATA

   |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
CONST
   MaxRecs                   = 5 ;
   FldCnt                    = 4 ;
   CurRec                    : longint = 1 ;
TYPE
   TDataRecord               = array [ 1..FldCnt ] of
                               string ;
   TDataArray                = array [ 1..MaxRecs ] of
                               TDataRecord ;
VAR
   DataArray                 : TDataArray ;
   {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

   DATA TRANSFER - note that we do NOT have to pay attention to the
   dialog's record structure; "Get/Set DataRec" (from the GENERAL
   unit) will access only sub-views which accept or return data.

   This lets us use plain, vanilla "string" type, so we can use the
   dialog's TInputLine to change the acceptable length of the field.

   |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
   {===================================================================

   DIALOG --> BUFFER (read each TInputLine field)

   ===================================================================}
procedure GetAllFields ( D : PDialog ) ;
var
   x                         : byte ;
begin
   for x := 1 to FldCnt do
      GetDataRec ( D ,
                   x ,
                   @DataArray[CurRec][x] ) ;
end ;
   {===================================================================

   BUFFER --> DIALOG (writes each TInputLine field)

   ===================================================================}
procedure SetAllFields ( D : PDialog ) ;
var
   x                         : byte ;
begin
   for x := 1 to FldCnt do
      SetDataRec ( D ,
                   x ,
                   @DataArray[CurRec][x] ) ;
   SetDataRec ( D , FldCnt + 1 , @CurRec ) ;
end ;
   {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

   FORM

   |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
TYPE
   PForm                     = ^TForm ;
   TForm                     = OBJECT ( TDialog )
   EditMode                  : boolean ;
   function GetHelpCtx       : word ; virtual ;
   procedure HandleEvent     ( VAR Event : TEvent ) ; virtual ;
                               END ;
   {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

   CONTEXT - Enable hints if in "EditMode"; disable otherwise.

   |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
function TForm.GetHelpCtx : word ;
var
   W                         : word ;
begin
   W                         := TDialog.GetHelpCtx ;
   if not EditMode then
      if W >= 1000 then
         W                   := hcNoContext ;
   GetHelpCtx                := W
end ;
   {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

   EVENT

   |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure TForm.HandleEvent ;
   {-------------------------------------------------------------------
   -------------------------------------------------------------------}
procedure hdPrevRecord ;
begin
   if CurRec = 1 then
   begin
      buzz ;
      EXIT ;
   end ;
   GetAllFields ( @SELF ) ;
   dec ( CurRec ) ;
   SetAllFields ( @SELF ) ;
end ;
   {-------------------------------------------------------------------
   -------------------------------------------------------------------}
procedure hdNextRecord ;
begin
   if CurRec = MaxRecs then
   begin
      buzz ;
      EXIT ;
   end ;
   GetAllFields ( @SELF ) ;
   inc ( CurRec ) ;
   SetAllFields ( @SELF ) ;
end ;
   {-------------------------------------------------------------------
   -------------------------------------------------------------------}
procedure hdFirst ;
begin
   GetAllFields ( @SELF ) ;
   CurRec                    := 1 ;
   SetAllFields ( @SELF ) ;
end ;
   {-------------------------------------------------------------------
   -------------------------------------------------------------------}
procedure hdLast ;
begin
   GetAllFields ( @SELF ) ;
   CurRec                    := MaxRecs ;
   SetAllFields ( @SELF ) ;
end ;
   {-------------------------------------------------------------------
   -------------------------------------------------------------------}
procedure hdEdit ;
begin
   EditMode                  := not EditMode ;
   if EditMode then
   begin
      SetStaticText ( @SELF , TRUE ) ;
      SetBorder ( CRT.LightRed ) ;
   end
   else
   begin
      SetStaticText ( @SELF , FALSE ) ;
      SetBorder ( CRT.LightGray ) ;
   end ;
end ;
   {===================================================================

   COMMAND

   ===================================================================}
procedure HandleCommand ;
begin
   case Event.Command of
   cmFirst             : hdFirst ;
   cmLast              : hdLast ;
   cmNextRecord        : hdNextRecord ;
   cmPrevRecord        : hdPrevRecord ;
   cmEdit              : hdEdit ;
   else
      EXIT ;
   end ;
   ClearEvent ( Event ) ;
end ;
   {===================================================================

   KEYDOWN

   ===================================================================}
procedure HandleKeyDown ;
begin
   if not EditMode then
   begin
      ClearEvent ( Event ) ;
      Buzz ;
      EXIT ;
   end ;
end ;
   {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   PROCESS
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
   case Event.What of
   evCommand : HandleCommand ;
   evKeyDown : HandleKeyDown ;
   end ;
   TDialog.HandleEvent ( Event ) ;
end ;